home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
netmail
/
rnr214.zip
/
RNRFILE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-01-21
|
3KB
|
181 lines
unit rnrfile;
{
rnrfile.pas - rnr file procedures
}
{ split off from the file: rnrproc.pas - rnr procedures }
{$I rnr-def.pas}
interface
uses dos,rnrglob,genericf { ,rnrfunc,rnrio,rnrproc,rnrmous } ;
procedure mkhier(hier: string);
procedure copyfile(oldfn,newfn: string);
procedure deletefile(fn: string);
procedure emptyfile(fn: string);
procedure movefile(oldfn,newfn: string);
procedure copyfilethenempty(oldfn,newfn: string);
procedure safereset(var f: text; fn: string);
procedure saferesetsize(var f: file; fn: string; size: integer);
procedure saferewrite(var f: text; fn: string);
implementation
procedure mkhier;
var
s: string;
i: integer;
fileinfo: searchrec;
dir: string;
begin
{$I-}
{if the directory already exists, don't worry about an error}
{WHY DOESN'T THIS WORK WITH TP6 ?!?!?!}
s := hier;
for i := 1 to length(s) do
if s[i]='/' then
s[i] := '\';
if length(s)>0 then
if s[length(s)]='\' then
s := copy(s,1,length(s)-1);
for i := 2 to length(s) do
if (s[i]='\') and (s[i-1]<>':') then
begin
dir := copy(s,1,i-1);
findfirst(dir,directory,fileinfo);
if doserror<>0 then
mkdir(dir);
end;
findfirst(s,directory,fileinfo);
if doserror<>0 then
mkdir(s);
{$I+}
end;
procedure copyfile;
const
bufsize=1024;
var
infile, outfile: file;
done: boolean;
numread: word;
buffer: array[1..bufsize] of char;
begin
assign(outfile,newfn);
rewrite(outfile,1);
assign(infile,oldfn);
reset(infile,1);
done := false;
while not done do
begin
blockread(infile,buffer,bufsize,numread);
blockwrite(outfile,buffer,numread);
done := (numread<bufsize);
end;
close(infile);
close(outfile);
end;
procedure deletefile;
var
f: file;
begin
assign(f,fn);
erase(f);
end;
procedure emptyfile;
var
f: file;
begin
assign(f,fn);
rewrite(f);
close(f);
end;
procedure movefile;
begin
copyfile(oldfn,newfn);
deletefile(oldfn);
end;
procedure copyfilethenempty;
begin
copyfile(oldfn,newfn);
emptyfile(oldfn);
end;
procedure safereset;
{no device checking done yet, since no reset routines need it}
begin
assign(f,fn);
{$I-}
reset(f);
{$I+}
fileresult := ioresult;
end;
procedure saferesetsize;
{no device checking done yet, since no reset routines need it}
begin
assign(f,fn);
{$I-}
reset(f,size);
{$I+}
fileresult := ioresult;
end;
procedure saferewrite;
{make sure it's not a device first}
begin
if isdev(fn) then
begin
fileresult := 199; {use an error code tpascal doesn't}
end
else
begin
assign(f,fn);
{$I-}
rewrite(f);
{$I+}
fileresult := ioresult;
end;
end;
end.